Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / rpc161a1.arc / RPC-PC.BAS < prev next >

Wrap

BASIC Source File | 1988-04-13 | 29.6 KB | 610 lines

****************************************************************************** ************************ RBBS-PC Protocol Controller **** RPC-PC.BAS ***** ************************ Merge for RBBS-PC.BAS ********************* ************************ By John Morris ******* 16-1A ******* ****************************************************************************** 104 ACKNOWLEDGE$ = CHR$(6) ACKC$ = "C" + _ ACKNOWLEDGE$ ACTIVE.MENU$ = "B" ACTIVE.MESSAGE$ = CHR$(225) BACKSPACE$ = CHR$(8) + _ CHR$(32) + _ CHR$(8) BACK.ARROW$ = CHR$(29) + _ CHR$(32) + _ CHR$(29) BULLETIN.MENU$ = "" C.L = 24 CANCEL$ = CHR$(24) COLOR.RESET$ = CHR$(27) + _ "[00;37;40m" CONFIG.FILENAME$ = "RBBS-PC.DEF" CARRIAGE.RETURN$ = CHR$(13) DELETED.MESSAGE$ = CHR$(226) END.TRANSMISSION$ = CHR$(4) ESCAPE$ = CHR$(27) EXPECT.ACTIVE.MODEM = 0 FALSE = 0 F1.KEY = 59 F10.KEY = 68 GRN$ = "MAIN" HOME.CONFERENCE$ = "" IN.CONF.MENU = -1 LIMIT.MINUTES.PER.SESSION! = 0 LINE.FEED$ = CHR$(10) LINE.FEEDS = NOT FALSE LINEEDIT.CHK$ = CHR$(9) + _ LINE.FEED$ + _ CHR$(11) + _ CHR$(12) + _ CHR$(127) + _ CHR$(8) + _ CHR$(7) + _ CHR$(26) + _ CHR$(227) LINEMES$ = SPACE$(74) ' fixed length string workspace LOCK.STATUS$ = "UM UU UB UD" NEGATIVE.ACKNOWLEDGE$ = CHR$(21) NO.ADVANCE = FALSE PAGE.LENGTH = 23 PARSE.OFF = FALSE PRESS.ENTER$ = " (Press [ENTER] to quit)" PRESS.ENTER.EXPERT$ = " ([ENTER] quits)" PRESS.ENTER.NOVICE$ = PRESS.ENTER$ PRIVATE.DOOR = FALSE RIGHT.MARGIN = 72 RETURN.LINE.FEED$ = CARRIAGE.RETURN$ + _ LINE.FEED$ START.OF.HEADER$ = CHR$(1) TIME.LOGGED.ON$ = SPACE$(8) TRUE = NOT FALSE * REPLACING old line(s) by new * ------[ first line different ]------ 105 VERSION.ID$ = "CPC16.1A + RPC" XOFF$ = CHR$(19) XON$ = CHR$(17) INTERRUPT.ON$ = CHR$(11) + CANCEL$ + XOFF$ + XON$ + CARRIAGE.RETURN$ ' ******************** Logon Error Message Table **************************** * REPLACING old line(s) by new 150 IF SUB.BOARD THEN _ GOSUB 12987 : _ GOSUB 5135 : _ GOTO 165 SYSOP.AVAILABLE = VAL(MID$(MESSAGE.RECORD$,32,2)) SYSOP.ANNOY = VAL(MID$(MESSAGE.RECORD$,34,2)) SYSOP.NEXT = VAL(MID$(MESSAGE.RECORD$,36,2)) PRINTER = VAL(MID$(MESSAGE.RECORD$,38,2)) IF TURN.PRINTER.OFF THEN _ PRINTER = FALSE EXIT.TO.DOORS = VAL(MID$(MESSAGE.RECORD$,40,2)) EIGHT.BIT = VAL(MID$(MESSAGE.RECORD$,42,2)) BPS = VAL(MID$(MESSAGE.RECORD$,44,2)) SNOOP = VAL(MID$(MESSAGE.RECORD$,58,2)) MID$(MESSAGE.RECORD$,57,1) = "I" * ------[ first line different ]------ PRIVATE.DOOR = VAL(MID$(MESSAGE.RECORD$,72,2)) MID$(MESSAGE.RECORD$,72,2) = STR$(FALSE) IF EXIT.TO.DOORS OR PRIVATE.DOOR THEN _ TURBO.LOGON = TRUE PUT 1,NODE.RECORD.INDEX GOSUB 12985 ' ' ***************************************************************************** ' * TEST FOR MULTI LINK PRESENT IF NOT COMPAQ COMPUTER * ' ***************************************************************************** ' * REPLACING old line(s) by new 200 TOGGLE.ONLY = TRUE CALL ANSWERIT GET 1,NODE.RECORD.INDEX SNOOP = VAL(MID$(MESSAGE.RECORD$,58,2)) TOGGLE.ONLY = FALSE IF EC > 1 THEN _ GOTO 13000 IF SUBROUTINE.PARAMETER < 0 THEN _ GOTO 202 ON SUBROUTINE.PARAMETER GOTO 410, _ ' 1 = ANSWERED PHONE & CARRIER FOUND 330, _ ' 2 = CARRIER FOUND BEFORE ANSWERING 822, _ ' 3 = SYSOP GETS SYSTEM NEXT 10595, _ ' 4 = ANSWERED PHONE BUT NO CARRIER 13540, _ ' 5 = NOT USED 202, _ ' 6 = LOCAL SYSOP KEY PRESSED 206, _ ' 7 = TIME TO DROP TO DOS * ------[ first line different ]------ 13538 ' 8 = NO CALLS! TIME TO RECYCLE * REPLACING old line(s) by new 420 IF MID$(MESSAGE.RECORD$,57,1) = "A" THEN _ LOGON.ERROR.INDEX = 6 : _ LG$(6) = LG$(6) + _ LEFT$(MESSAGE.RECORD$,25) : _ GOTO 10620 FIRST.NAME$ = LEFT$(MESSAGE.RECORD$,INSTR(MESSAGE.RECORD$, " ") - 1) * ------[ first line different ]------ IF (NOT PRIVATE.DOOR) THEN _ IF NOT (NOT EXIT.TO.DOORS) THEN _ CALL SKIPLINE (1) : _ CALL QTPUT(FIRST.NAME$ + ", welcome back!",1) ' ' ***************************************************************************** ' * TEST FOR REMOTE SYSOP LOGGING ON * ' ***************************************************************************** ' * REPLACING old line(s) by new * ------[ first line different ]------ 480 IF (PRIVATE.DOOR) OR (EXIT.TO.DOORS) THEN _ Z$ = PASSWORD.SAVE$ : _ PASSWORD.FAILED = 0 : _ GOTO 644 IF Q => 3 THEN _ Z$ = B$(3) : _ ATTEMPTS = 1 : _ GOSUB 677 _ ELSE GOSUB 675 * REPLACING old line(s) by new * ------[ first line different ]------ 755 IF PRIVATE.DOOR OR (EXIT.TO.DOORS) THEN _ B$(1) = PASSWORD$ : _ Z$ = B$(1) : _ RETURN GOSUB 12800 A$ = "Re-enter PASSWORD for verification (Dots Echo)" GOSUB 45010 SWAP Z$,B$(1) CALL ALLCAPS (Z$) IF B$(1) <> Z$ THEN _ CALL QTPUT ("Passwords Don't match!",1) : _ GOTO 755 RETURN ' ' ***************************************************************************** ' * R - COMMAND FROM NEWUSER ROUTINE - REGISTER * ' ***************************************************************************** ' * REPLACING old line(s) by new 800 IF ORIG.CONFIG$ = CURRENT.DEF$ THEN _ MAIN.USER.FILE.INDEX = USER.FILE.INDEX : _ USER.SECURITY.SAVE = USER.SECURITY.LEVEL TIMES.LOGGED.ON = CVI(MID$(USER.OPTIONS$,1,2)) - _ (ORIG.CONFIG$ <> CURRENT.DEF$ OR NOT SUB.BOARD) GOSUB 9500 PREV.LAST.ON$ = LAST.DATE.TIME.ON$ IF NOT SUB.BOARD THEN _ BOARD.CHECK.DATE$ = PREV.LAST.ON$ * ------[ first line different ]------ IF (PRIVATE.DOOR OR SUB.BOARD) OR (EXIT.TO.DOORS) THEN _ GOTO 815 GOSUB 465 IF (EIGHT.BIT AND _ AUTODOWNLOAD.DESIRED) OR _ ASK.IDENTITY THEN _ CALL TESTUSER CALL QTPUT ("Logging " + ACTIVE.USER.NAME$,1) CALL QTPUT ("RBBS-PC " + VERSION.ID$ + " NODE " + NODE.ID$,1) CALL QTPUT (" OPERATING AT " + BAUD.PARITY$,1) ATTEMPTS = 0 GOSUB 435 * REPLACING old line(s) by new 828 EIGHT.BIT = TRUE GR = 1 CI$ = "LOCAL" * ------[ first line different ]------ EXIT.TO.DOORS = FALSE PRIVATE.DOOR = FALSE TURBO.LOGON = FALSE LINE.FEEDS = TRUE RETURN.LINE.FEED$ = LINE.FEED$ USER.SECURITY.LEVEL = SYSOP.SECURITY.LEVEL * REPLACING old line(s) by new 900 GOSUB 1895 SUBROUTINE.PARAMETER = 2 CALL LINE25 CALL CALLOPT SECTION$ = " " EXIT.TO.DOORS = FALSE A$ = "" NEW.USER = FALSE GOSUB 2350 IF NOT PRIVATE.DOOR THEN _ GOTO 955 GOSUB 20262 * ------[ first line different ]------ IF MENU.INDEX = 3 OR (TRANSFER.FUNCTION > 0) THEN _ GOSUB 1275 _ ELSE GOSUB 1280 PRIVATE.DOOR = FALSE GOTO 1205 * REPLACING old line(s) by new 1900 GOSUB 5344 * ------[ first line different ]------ IF (PRIVATE.DOOR) OR (EXIT.TO.DOORS) THEN _ ACTION.FLAG = TRUE PREV.BASE$ = ACTIVE.MESSAGE.FILE$ SHOW.ACTIVE = FALSE IF NOT ACTION.FLAG THEN _ A$ = "Checking messages in " + _ GRN$ : _ GOSUB 12978 : _ SHOW.ACTIVE = TRUE _ ELSE CALL QTPUT ("Re-loading messages...",1) : _ FOR I = 1 TO Q: _ A$(I) = B$(I) : _ NEXT I = 0 MESSAGES.FROM.USER = FALSE ACTIVE.MESSAGES = 0 GOSUB 23000 MESSAGE.RECORD = FIRST.MESSAGE.RECORD ACTIVE.DELAY! = 0 MAXIMUM.MESSAGES = VAL(MID$(MESSAGE.RECORD$,89,7)) IF MAXIMUM.MESSAGES > MM THEN _ MAXIMUM.MESSAGES = MM REDIM M(MAXIMUM.MESSAGES,2) 5410 GOSUB 4241 GOSUB 43020 FF = INSTR(DFLTXFER$,USER.TRANSFER.DEFAULT$) * ------[ first line different ]------ FF = FF -(LEN(DFLTXFER$)) * (FF < 1) GOSUB 42810 GOSUB 42970 GOSUB 4110 GOSUB 42720 GOSUB 4210 GOSUB 4125 GOSUB 4150 GOSUB 1560 IF RESTRICT.BY.DATE THEN _ IF USER.SECURITY.LEVEL > EXPIRED.SECURITY THEN _ CALL QTPUT ("Registration expires " + EXPIRATION.DATE$,1) RETURN ' ' ***************************************************************************** ' * B - COMMAND FROM UTILITY MENU (300 TO 450 BAUD CHANGE) * ' ***************************************************************************** ' * REPLACING old line(s) by new 12600 GOSUB 4910 GOSUB 12988 IF IN.CONF.MENU THEN _ * ------[ first line different ]------ IF (NOT PRIVATE.DOOR) THEN _ IF (NOT EXIT.TO.DOORS) THEN _ CALL QTPUT ("Checking Users...",1) * REPLACING old line(s) by new * ------[ first line different ]------ 13000 IF DEBUG THEN _ A$ = "RBBS-PC DEBUG Error Trap Entry ERL=" + _ STR$(EL) + _ " ERR=" + _ STR$(EC) : _ CALL PRINTIT(A$) : _ D$ = A$ : _ GOSUB 1315 IF EL = 1905 AND EC = 63 THEN _ CLOSE 1 : _ KILL ACTIVE.MESSAGE.FILE$ : _ GOTO 5350 IF EL = 4371 AND EC = 6 THEN _ GOTO 1200 IF EL = 4740 THEN _ GOTO 4745 IF EL = 5151 AND EC = 62 THEN _ CALL UPDTCALR (PASSWORDS.FILE$ + " bad format!",2) : _ GOTO 5160 IF EL = 7130 AND EC = 53 THEN _ GOTO 7260 IF EL = 20242 AND EC = 62 THEN _ CALL UPDTCALR (FILESEC.FILE$ + " bad format!",2) : _ GOTO 20247 IF (EL = 20262 AND EC = 5) OR _ ' RPC16-1A (EL = 20263 AND EC = 62) THEN _ ' RPC16-1A A$ = "<Download aborted>" : _ ' RPC16-1A DOWNLOAD.COMPLETED = FALSE : _ ' RPC16-1A GOTO 20390 ' RPC16-1A IF EL = 20262 AND EC = 53 THEN _ ' RPC16-1A GOTO 20267 ' RPC16-1A IF EL = 20263 AND EC = 53 THEN _ ' RPC16-1A IF TRANSFER.FUNCTION = 2 THEN _ ' RPC16-1A GOTO 20730 : _ ' RPC16-1A ELSE _ ' RPC16-1A DOWNLOAD.COMPLETE = FALSE : _ ' RPC16-1A GOTO 20267 ' RPC16-1A IF EL = 20452 AND EC = 53 THEN _ GOTO 20451 IF EL = 20560 AND EC = 67 THEN _ GOTO 20451 IF EL = 20560 AND EC = 70 THEN _ IF VAL(FREE.SPACE$) > 1999 THEN _ GOTO 20610 _ ELSE CALL QTPUT ("No room for uploads. Try tomorrow.",1) : _ GOTO 5160 IF EL = 20620 THEN _ GOTO 20670 IF EL = 20650 THEN _ GOTO 20670 IF EL = 20736 AND EC = 53 THEN _ GOTO 5160 IF EL = 20900 AND EC = 75 THEN _ GOTO 21230 IF EL = 20900 AND EC = 70 THEN _ CALL QTPUT ("No room for uploads. Try tomorrow.",1) : _ GOTO 21230 IF EL = 21131 THEN _ EC = 0 : _ GOTO 21230 IF EL = 21480 THEN _ CALL LOGERROR : _ IF EC = 57 THEN _ CALL QTPUT("Error reading file. Aborting download",1) : _ DOWNLOAD.COMPLETED = FALSE : _ GOTO 21230 * REPLACING old line(s) by new 20202 LAST.DOWNLOAD = Q FIRST.DOWNLOAD = B COMMAND.TRANSFER$ = "" IF AUTODOWNLOAD.AVAILABLE THEN _ COMMAND.TRANSFER$ = "X" AUTODOWNLOAD.IN.PROGRESS = AUTODOWNLOAD.AVAILABLE IF LAST.DOWNLOAD > FIRST.DOWNLOAD THEN _ Z$ = B$(LAST.DOWNLOAD) : _ CALL ALLCAPS(Z$) : _ * ------[ first line different ]------ IF LEN (Z$) = 1 AND INSTR(DFLTXFER$,Z$) > 0 THEN _ ' RPC16-1A LAST.DOWNLOAD = LAST.DOWNLOAD - 1 : _ COMMAND.TRANSFER$ = Z$ : _ AUTODOWNLOAD.IN.PROGRESS = FALSE FOR DWN.INDEX = FIRST.DOWNLOAD TO LAST.DOWNLOAD GOSUB 20205 * REPLACING old line(s) by new 20260 TRANSFER.FUNCTION = 1 * ------[ first line different ]------ GOSUB 50630 IF FF = 1 THEN _ ' RPC16-1A GOTO 20340 ' RPC16-1A IF INSTR("XC",FT$) THEN _ ' RPC16-1A GOTO 20290 ' RPC16-1A IF FT$ = "Y" THEN _ ' RPC16-1A GOTO 20270 ' RPC16-1A IF FT$ = "N" THEN 5160 ELSE 20261 ' RPC16-1A ' ' ***************************************************************************** ' * R - P - C Control ALL External Protocol Drivers here * ' ***************************************************************************** ' * REPLACING old line(s) by new * ------[ first line different ]------ 20261 IF NOT PRIVATE.DOOR THEN ' RPC16-1A IF NOT EIGHT.BIT THEN ' RPC16-1A A$ = "Please SWITCH to N,8,1 for binary transfer" ' RPC16-1A CALL QTPUT(A$,1) ' RPC16-1A CALL DELAYIT (3) ' RPC16-1A IF NOT EIGHT.BIT THEN ' RPC16-1A CALL DELAYIT (3) ' RPC16-1A OUT LINE.CONTROL.REGISTER,3 ' RPC16-1A END IF ' RPC16-1A SO = 0 ' RPC16-1A END IF ' RPC16-1A IF INSTR("89",MODE$(FF)) THEN _ ' RPC16-1A BLOCK.SIZE = 8 _ ' RPC16-1A ELSE BLOCK.SIZE = 1 ' RPC16-1A IF TRANSFER.FUNCTION = 1 THEN _ ' RPC16-1A GOSUB 20750 : _ ' RPC16-1A CLOSE 2 ' RPC16-1A IF AUTODOWNLOAD.IN.PROGRESS THEN _ ' RPC16-1A CALL SENDNAME : _ ' RPC16-1A IF ABORT THEN _ ' RPC16-1A DOWNLOAD.COMPLETED = FALSE : _ ' RPC16-1A GOSUB 50600 : _ ' RPC16-1A RETURN ' RPC16-1A CALL TRANSFER ' RPC16-1A END IF ' RPC16-1A CLOSE 2 ' RPC16-1A CALL LINE25 ' RPC16-1A CALL CARRIER ' RPC16-1A IF SUBROUTINE.PARAMETER = -1 THEN _ ' RPC16-1A A$ = "F" : _ ' RPC16-1A GOTO 20264 ' RPC16-1A * REPLACING old line(s) by new ' RPC16-1A * ------[ first line different ]------ ' RPC16-1A 20262 IF SUCCESS.CHECK.METHOD$(FF) = "DSZ" THEN ' RPC16-1A IF TRANSFER.FUNCTION = 2 THEN _ ' RPC16-1A GOTO 20700 ' RPC16-1A CLOSE 2 ' RPC16-1A CALL OPENWORK ("XFER-" + NODE.ID$ + ".DEF") ' RPC16-1A IF EC <> 0 THEN _ ' RPC16-1A EL = 20262 : _ ' RPC16-1A GOTO 13000 ' RPC16-1A CALL READDIR ' RPC16-1A IF (RUN.METHOD$(FF) = "E" AND PRIVATE.DOOR) AND (LEN(A$) > 1) THEN FT$ = MID$(DFLTXFER$,FF,1) ' RPC16-1A SIZE.ONLY = TRUE ' RPC16-1A GOSUB 20750 ' RPC16-1A END IF ' RPC16-1A DOWNLOAD.COMPLETED = TRUE ' RPC16-1A IF LEFT$(A$,1) = "E" OR LEFT$(A$,1) = "L" THEN _ ' RPC16-1A DOWNLOAD.COMPLETED = FALSE ' RPC16-1A GOSUB 50600 ' RPC16-1A CALL KILLWORK ("XFER-" + NODE.ID$ + ".DEF") ' RPC16-1A RETURN ' RPC16-1A END IF ' RPC16-1A * INSERTING new line(s) ' RPC16-1A 20263 CALL OPENWORK ("XFER-" + NODE.ID$ + ".DEF") ' RPC16-1A IF EC <> 0 THEN _ ' RPC16-1A GOTO 20267 ' RPC16-1A FOR I = 1 TO 4 ' RPC16-1A CALL READANY ' RPC16-1A IF EC <> 0 THEN _ ' RPC16-1A GOTO 20267 ' RPC16-1A IF I = 1 THEN _ ' RPC16-1A C$ = A$ ' RPC16-1A IF I = 3 THEN _ ' RPC16-1A B$ = A$ ' RPC16-1A NEXT ' RPC16-1A * REPLACING old line(s) by new ' RPC16-1A * ------[ first line different ]------ ' RPC16-1A 20264 IF PRIVATE.DOOR THEN _ ' RPC16-1A PRIVATE.DOOR = 0 : _ ' RPC16-1A FILE.NAME$ = C$ : _ ' RPC16-1A CALL BRKFNAME (FILE.NAME$,X$,FILE.NAME.HOLD$,Y$,TRUE) : _ ' RPC16-1A FILE.NAME.HOLD$ = FILE.NAME.HOLD$ + _ ' RPC16-1A Y$ : _ ' RPC16-1A FT$ = LEFT$(B$,1) : _ ' RPC16-1A SIZE.ONLY = TRUE : _ ' RPC16-1A GOSUB 20750 ' RPC16-1A IF TRANSFER.FUNCTION = 2 THEN _ ' RPC16-1A IF LEFT$(A$,1) = "S" THEN _ ' RPC16-1A GOTO 20700 _ ' RPC16-1A ELSE GOTO 20730 ' RPC16-1A IF TRANSFER.FUNCTION = 1 THEN _ ' RPC16-1A IF LEFT$(A$,1) = "S" THEN _ ' RPC16-1A DOWNLOAD.COMPLETED = TRUE _ ' RPC16-1A ELSE DOWNLOAD.COMPLETED = FALSE ' RPC16-1A GOSUB 50600 ' RPC16-1A RETURN ' RPC16-1A ' ' ***************************************************************************** ' * XFER FILE NOT FOUND * ' ***************************************************************************** ' * DELETING old line(s) 20265 * REPLACING old line(s) by new 20292 GOSUB 20750 ' RPC16-1A * ------[ first line different ]------ A1$ = "send" ' RPC16-1A GOSUB 20320 ' RPC16-1A IF AUTODOWNLOAD.IN.PROGRESS THEN _ ' RPC16-1A CALL SENDNAME : _ ' RPC16-1A IF ABORT THEN _ ' RPC16-1A RETURN 20792 ' RPC16-1A GOSUB 21300 ' RPC16-1A A$ = "" ' RPC16-1A GOTO 20390 ' RPC16-1A * REPLACING old line(s) by new ' RPC16-1A * ------[ first line different ]------ 20330 IF AUTODOWNLOAD.IN.PROGRESS THEN _ ' RPC16-1A RETURN ' RPC16-1A A$ = "Xmodem" + _ ' RPC16-1A XMODEM.TYPE$ + _ ' RPC16-1A A1$ + _ ' RPC16-1A " of " + _ ' RPC16-1A FILE.NAME.HOLD$ + _ ' RPC16-1A " ready. <Ctrl X> aborts" ' RPC16-1A IF FF = 4 THEN _ ' RPC16-1A MID$(A$,1,1) = "Y" ' RPC16-1A GOSUB 12979 ' RPC16-1A RETURN ' RPC16-1A ' ' ***************************************************************************** ' * ASCII DOWNLOAD DRIVER * ' ***************************************************************************** ' * REPLACING old line(s) by new 20340 IF DF THEN _ ' RPC16-1A A$ = "Switch to a non-ascii protocol" : _ ' RPC16-1A GOSUB 12979 : _ ' RPC16-1A RETURN ' RPC16-1A CALL OPENWORK (FILE.NAME$) ' RPC16-1A BLOCK.SIZE = 1 ' RPC16-1A GOSUB 20760 ' RPC16-1A IF (DWN.INDEX = FIRST.DOWNLOAD OR NOT CONCAT.FILES) THEN _ ' RPC16-1A A$ = "^X aborts. ^S suspends ^Q resumes" : _ ' RPC16-1A GOSUB 12977 : _ ' RPC16-1A * ------[ first line different ]------ A$ = "Ascii send of " + _ ' RPC16-1A FILE.NAME.HOLD$ + _ ' RPC16-1A " ready. Press [ENTER] to start" : _ ' RPC16-1A GOSUB 12995 ' RPC16-1A * REPLACING old line(s) by new 20500 TRANSFER.FUNCTION = 2 ' RPC16-1A * ------[ first line different ]------ AUTODOWNLOAD.IN.PROGRESS = FALSE ' RPC16-1A GOSUB 50630 ' RPC16-1A IF FF = 1 THEN _ ' RPC16-1A GOTO 20560 ' RPC16-1A IF INSTR("XC",FT$) THEN _ ' RPC16-1A GOTO 20540 ' RPC16-1A IF FT$ = "Y" THEN _ ' RPC16-1A GOTO 20520 ' RPC16-1A IF FT$ = "N" THEN 20735 ELSE 20261 ' RPC16-1A * REPLACING old line(s) by new * ------[ first line different ]------ 20542 A1$ = "receive" ' RPC16-1A GOSUB 20320 ' RPC16-1A OK = TRUE ' RPC16-1A GOSUB 20860 ' RPC16-1A IF OK THEN _ ' RPC16-1A GOTO 20700 ' RPC16-1A GOTO 20730 ' RPC16-1A ' ' ***************************************************************************** ' * ASCII UPLOAD * ' ***************************************************************************** ' * REPLACING old line(s) by new 20560 LINE.ACK = (DEFAULT.LINE.ACK$ <> "") ' RPC16-1A IF LINE.ACK THEN _ ' RPC16-1A A$ = "Acknowledge each line ([Y],N)" : _ ' RPC16-1A GOSUB 12995 : _ ' RPC16-1A LINE.ACK = NOT NO ' RPC16-1A CALL QTPUT("Transfer MUST end with a <Ctrl-K>",1) ' RPC16-1A * ------[ first line different ]------ CALL QTPUT("Ascii receive of " + FILE.NAME.HOLD$ + " ready",1) ' RPC16-1A OK = FALSE ' RPC16-1A XOFF = FALSE ' RPC16-1A CALL OPENOUTW(FILE.NAME$) ' RPC16-1A IF EC <> 0 AND EC <> 53 THEN _ ' RPC16-1A EL = 20560 : _ ' RPC16-1A GOTO 13000 ' RPC16-1A GOSUB 20510 ' RPC16-1A * REPLACING old line(s) by new * ------[ first line different ]------ 20750 IF FF = 4 THEN _ ' RPC16-1A START.OF.HEADER$ = CHR$(2) : _ ' RPC16-1A BLOCK.SIZE = 1 : _ ' RPC16-1A FLEN = 1024 _ ' RPC16-1A ELSE START.OF.HEADER$ = CHR$(1) : _ ' RPC16-1A FLEN = 128 ' RPC16-1A SWAP BUFFER.SIZE,FLEN ' RPC16-1A CALL OPENRSEQ (FILE.NAME$,MAX.BLOCK,DF) ' RPC16-1A SWAP BUFFER.SIZE,FLEN ' RPC16-1A * REPLACING old line(s) by new 20780 A$ = "FILE SIZE: " ' RPC16-1A * ------[ first line different ]------ IF INSTR("245",MODE$(FF)) THEN _ ' RPC16-1A A$ = A$ + _ ' RPC16-1A STR$(CINT((FIX(BLOCKS.IN.FILE#) / BLOCK.SIZE)+.49)) + _ ' RPC16-1A " blocks " ' RPC16-1A * REPLACING old line(s) by new * ------[ first line different ]------ 20785 TLA = 143 ' RCP16-1A BLOCKS.IN.FILE# = BLOCKS.IN.FILE# * _ ' RPC16-1A TLA / _ ' RPC16-1A VAL(MID$("0000030004501200240048009601920", -4 * BPS, 4)) BLOCKS.IN.FILE# = BLOCKS.IN.FILE# * FLEN / 128 ' RPC16-1A IF (DWN.INDEX > 1 AND CONCAT.FILES) THEN _ ' RPC16-1A GOTO 20792 ' RPC16-1A A$ = A$ + _ ' RPC16-1A STR$(BYTES.IN.FILE#) + _ ' RPC16-1A " bytes" ' RPC16-1A GOSUB 12979 ' RPC16-1A IF BYTES.IN.FILE# < 1 THEN _ ' RPC16-1A RETURN 20792 ' RPC16-1A * REPLACING old line(s) by new * ------[ first line different ]------ 42810 IF PROT.NAME$(FF) = "" THEN _ ' RPC16-1A USER.PROTOCOL$ = "None" ELSE _ ' RPC16-1A USER.PROTOCOL$ = PROT.NAME$(FF) ' RPC16-1A A$ = "PROTOCOL: " + _ ' RPC16-1A USER.PROTOCOL$ ' RPC16-1A GOSUB 12979 ' RPC16-1A RETURN ' RPC16-1A ' ' ***************************************************************************** ' * C - COMMAND FROM UTILITY MENU (CHANGE CASE TOGGLE) * ' * UPPER/LOWER CASE SET FOR NEW USERS * ' ***************************************************************************** '